PC Plus SuperCD (UK) 1999 January/PC Plus Super CD No55a (PCP-147A-1-99) (Disc 1) (1998).iso/linux/developers/visualtcl/windows/vtcl/lib/lib_blt.tcl

Text File | 1997-10-23 | 4.9 KB | 190 lines

##############################################################################
#
# lib_blt.tcl - blt widget support library
#
# Copyright (C) 1996-1997 Stewart Allen
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# Architecture by Stewart Allen
# Implementation by James Kramer usinge ideas from
# Kenneth H. Cox <[e-mail]>

#
# Initializes this library
#
#if {[info exist blt_library] == 1} {
#    global auto_path blt_library
#    lappend auto_path $blt_library
#    catch {
#        import add blt
#    }
#}

proc vTcl:widget:lib:lib_blt {args} {
    global vTcl blt_library
    #
    # see if we're running bltWish. if not, return
    #
    if {[info exist blt_library] == 0} {
        return
    } else {
        global auto_path blt_library tcl_version
        lappend auto_path $blt_library
        if {$tcl_version < 8} {
            catch {
                import add blt
            }
        } else {
            catch {
                package require BLT
                import add blt
            }
            catch {
                namespace import blt::*
            }
        }

    }

    # setup required variables
    vTcl:lib_blt:setup

    # add items to toolbar
    foreach i {
        graph
    } {
        set img_file [file join $vTcl(VTCL_HOME) images icon_$i.gif]
        if {![file exists $img_file]} {
            set img_file [file join $vTcl(VTCL_HOME) images icon_tix_unknown.gif]
        }
        image create photo "ctl_$i" -file $img_file
        vTcl:toolbar_add $i $i ctl_$i ""
    }
    # The Widget Browser needs images for all blt classes.
    # The images need to be called, e.g. ctl_bltNoteBookFrame.
    # Don't put these in the toolbar, because they are not commands,
    # only classes.
}

proc vTcl:lib_blt:setup {} {
    global vTcl

    #
    # additional attributes to set on insert
    #
    set vTcl(graph,insert)       "-background white -plotrelief groove -foreground black"

    #
    # add to procedure, var, bind regular expressions
    #
    if {"$vTcl(bind,ignore)" != ""} {
        append vTcl(bind,ignore) "|tix"
    } else {
        append vTcl(bind,ignore) "tix"
    }
    append vTcl(proc,ignore) "|tix"
    append vTcl(var,ignore)  "|tix"

    #
    # add to valid class list
    #
    lappend vTcl(classes) \
        Graph

    #
    # register additional options that might be on Blt widgets,
    # and the option information that the Attribute Editor needs.
    #
    lappend vTcl(opt,list) \
            -plotbackground \
            -plotborderwidth \
            -plotrelief \
            -title

    set vTcl(opt,-plotbackground) { {Plot BgColor}    Colors   color   {} }
    set vTcl(opt,-plotborderwidth) { {Plot Width}        longname type    {} }
    set vTcl(opt,-plotrelief)      { {Plot Relief}          {}       choice  {flat groove raised ridge sunken} }
    set vTcl(opt,-title)          { Title               longname type    {} }

    #
    # define dump procedures for widget types
    #
    set vTcl(Graph,dump_opt)         vTcl:lib_blt:dump_widget_opt

    #
    # define whether or not do dump children of a class
    #
    set vTcl(Graph,dump_children)         0
}

#
# individual widget commands executed after insert
#
proc vTcl:widget:graph:inscmd {target} {
    return ""
}

proc vTcl:widget:graph:dblclick {target} {
    puts "IN graph:dblclick"
}

proc vTcl:widget:dump_graph {target basename} {
    set results [vTcl:lib_blt:dump_widget_opt $target $basename]
    puts "IN graph:dump_graph"
    return $results
}

#
# per-widget-class dump procedures
#

# Utility proc.  Ignore color options (-background, etc.) based on
# preference.
#
# returns:
#   1 means save the option
#   0 means don't save it
proc vTcl:lib_blt:save_option {opt} {
        return 1
}

# Utility proc.  Dump a blt widget.
# Differs from vTcl:dump_widget_opt in that it tries harder to avoid
# dumping options that shouldn't really be dumped, e.g. -fg,-bg,-font.
proc vTcl:lib_blt:dump_widget_opt {target basename} {
    global vTcl
    set result ""
    set class [vTcl:get_class $target]
    set result "$vTcl(tab)[vTcl:lower_first $class] $basename"
    set opt [$target configure]
    set keep_opt ""
    foreach e $opt {
        if [vTcl:lib_blt:save_option $e] {
            lappend keep_opt $e
        }
    }
    set p [vTcl:get_opts $keep_opt]
    if {$p != ""} {
        append result " \\\n[vTcl:clean_pairs $p]\n"
    } else {
        append result "\n"
    }
    append result [vTcl:dump_widget_bind $target $basename]
    return $result
}